home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-1 / Inter.Net 55-1.iso / CBuilder / Setup / BCB / data.z / axctrls.int < prev    next >
Encoding:
Text File  |  1998-02-09  |  24.2 KB  |  603 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {       ActiveX Controls Unit                           }
  5. {                                                       }
  6. {       Copyright (c) 1998 Borland International        }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit AxCtrls;
  11.  
  12. interface
  13.  
  14. (*$HPPEMIT '' *)
  15. (*$HPPEMIT '#include <objsafe.h>' *)
  16. (*$HPPEMIT '' *)
  17.  
  18. uses
  19.   Windows, Messages, ActiveX, SysUtils, ComObj, Classes, Graphics,
  20.   Controls, Forms, ExtCtrls, StdVcl;
  21.  
  22. const
  23.   { Delphi property page CLSIDs }
  24.   Class_DColorPropPage: TGUID = '{5CFF5D59-5946-11D0-BDEF-00A024D1875C}';
  25.   Class_DFontPropPage: TGUID = '{5CFF5D5B-5946-11D0-BDEF-00A024D1875C}';
  26.   Class_DPicturePropPage: TGUID = '{5CFF5D5A-5946-11D0-BDEF-00A024D1875C}';
  27.   Class_DStringPropPage: TGUID = '{F42D677E-754B-11D0-BDFB-00A024D1875C}';
  28.  
  29. type
  30.   TOleStream = class(TStream)
  31.   public
  32.     constructor Create(const Stream: IStream);
  33.     function Read(var Buffer; Count: Longint): Longint; override;
  34.     function Write(const Buffer; Count: Longint): Longint; override;
  35.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  36.   end;
  37.  
  38.   TAggregatedObject = class
  39.   protected
  40.     { IUnknown }
  41.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  42.     function _AddRef: Integer; stdcall;
  43.     function _Release: Integer; stdcall;
  44.   public
  45.     constructor Create(Controller: IUnknown);
  46.     property Controller: IUnknown;
  47.   end;
  48.  
  49.   TContainedObject = class(TAggregatedObject, IUnknown)
  50.   protected
  51.     { IUnknown }
  52.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  53.   end;
  54.  
  55.   TConnectionPoints = class;
  56.  
  57.   TConnectEvent = procedure (const Sink: IUnknown; Connecting: Boolean) of object;
  58.   TConnectionKind = (ckSingle, ckMulti);
  59.  
  60.   TConnectionPoint = class(TContainedObject, IConnectionPoint)
  61.   protected
  62.     { IConnectionPoint }
  63.     function GetConnectionInterface(out iid: TIID): HResult; stdcall;
  64.     function GetConnectionPointContainer(
  65.       out cpc: IConnectionPointContainer): HResult; stdcall;
  66.     function Advise(const unkSink: IUnknown; out dwCookie: Longint): HResult; stdcall;
  67.     function Unadvise(dwCookie: Longint): HResult; stdcall;
  68.     function EnumConnections(out enumconn: IEnumConnections): HResult; stdcall;
  69.   public
  70.     constructor Create(Container: TConnectionPoints;
  71.       const IID: TGUID; Kind: TConnectionKind; OnConnect: TConnectEvent);
  72.     destructor Destroy; override;
  73.   end;
  74.  
  75.   TConnectionPoints = class(TAggregatedObject,
  76.     IConnectionPointContainer)
  77.   protected
  78.     { IConnectionPointContainer }
  79.     function EnumConnectionPoints(
  80.       out enumconn: IEnumConnectionPoints): HResult; stdcall;
  81.     function FindConnectionPoint(const iid: TIID;
  82.       out cp: IConnectionPoint): HResult; stdcall;
  83.   public
  84.     constructor Create(const Controller: IUnknown);
  85.     destructor Destroy; override;
  86.     function CreateConnectionPoint(const IID: TGUID; Kind: TConnectionKind;
  87.       OnConnect: TConnectEvent): TConnectionPoint;
  88.   end;
  89.  
  90.   TDefinePropertyPage = procedure(const GUID: TGUID) of object;
  91.  
  92.   TActiveXControlFactory = class;
  93.  
  94.   IAmbientDispatch = dispinterface
  95.     ['{00020400-0000-0000-C000-000000000046}']
  96.     property BackColor: Integer dispid DISPID_AMBIENT_BACKCOLOR;
  97.     property DisplayName: WideString dispid DISPID_AMBIENT_DISPLAYNAME;
  98.     property Font: IFontDisp dispid DISPID_AMBIENT_FONT;
  99.     property ForeColor: Integer dispid DISPID_AMBIENT_FORECOLOR;
  100.     property LocaleID: Integer dispid DISPID_AMBIENT_LOCALEID;
  101.     property MessageReflect: WordBool dispid DISPID_AMBIENT_MESSAGEREFLECT;
  102.     property ScaleUnits: WideString dispid DISPID_AMBIENT_SCALEUNITS;
  103.     property TextAlign: Smallint dispid DISPID_AMBIENT_TEXTALIGN;
  104.     property UserMode: WordBool dispid DISPID_AMBIENT_USERMODE;
  105.     property UIDead: WordBool dispid DISPID_AMBIENT_UIDEAD;
  106.     property ShowGrabHandles: WordBool dispid DISPID_AMBIENT_SHOWGRABHANDLES;
  107.     property ShowHatching: WordBool dispid DISPID_AMBIENT_SHOWHATCHING;
  108.     property DisplayAsDefault: WordBool dispid DISPID_AMBIENT_DISPLAYASDEFAULT;
  109.     property SupportsMnemonics: WordBool dispid DISPID_AMBIENT_SUPPORTSMNEMONICS;
  110.     property AutoClip: WordBool dispid DISPID_AMBIENT_AUTOCLIP;
  111.   end;
  112.  
  113.   TActiveXControl = class(TAutoObject,
  114.     IPersistPropertyBag,
  115.     IPersistStreamInit,
  116.     IPersistStorage,
  117.     IObjectSafety,
  118.     IOleObject,
  119.     IOleControl,
  120.     IOleInPlaceObject,
  121.     IOleInPlaceActiveObject,
  122.     IViewObject,
  123.     IViewObject2,
  124.     IPerPropertyBrowsing,
  125.     ISpecifyPropertyPages,
  126.     ISimpleFrameSite)
  127.   protected
  128.     { Renamed methods }
  129.     function IPersistPropertyBag.InitNew = PersistPropBagInitNew;
  130.     function IPersistPropertyBag.Load = PersistPropBagLoad;
  131.     function IPersistPropertyBag.Save = PersistPropBagSave;
  132.     function IPersistStreamInit.Load = PersistStreamLoad;
  133.     function IPersistStreamInit.Save = PersistStreamSave;
  134.     function IPersistStorage.InitNew = PersistStorageInitNew;
  135.     function IPersistStorage.Load = PersistStorageLoad;
  136.     function IPersistStorage.Save = PersistStorageSave;
  137.     function IViewObject2.GetExtent = ViewObjectGetExtent;
  138.     { IPersist }
  139.     function GetClassID(out classID: TCLSID): HResult; stdcall;
  140.     { IPersistPropertyBag }
  141.     function PersistPropBagInitNew: HResult; stdcall;
  142.     function PersistPropBagLoad(const pPropBag: IPropertyBag;
  143.       const pErrorLog: IErrorLog): HResult; stdcall;
  144.     function PersistPropBagSave(const pPropBag: IPropertyBag; fClearDirty: BOOL;
  145.       fSaveAllProperties: BOOL): HResult; stdcall;
  146.     { IPersistStreamInit }
  147.     function IsDirty: HResult; stdcall;
  148.     function PersistStreamLoad(const stm: IStream): HResult; stdcall;
  149.     function PersistStreamSave(const stm: IStream;
  150.       fClearDirty: BOOL): HResult; stdcall;
  151.     function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
  152.     function InitNew: HResult; stdcall;
  153.     { IPersistStorage }
  154.     function PersistStorageInitNew(const stg: IStorage): HResult; stdcall;
  155.     function PersistStorageLoad(const stg: IStorage): HResult; stdcall;
  156.     function PersistStorageSave(const stgSave: IStorage;
  157.       fSameAsLoad: BOOL): HResult; stdcall;
  158.     function SaveCompleted(const stgNew: IStorage): HResult; stdcall;
  159.     function HandsOffStorage: HResult; stdcall;
  160.     { IObjectSafety }
  161.     function GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions,
  162.       pdwEnabledOptions: PDWORD): HResult; virtual; stdcall;
  163.     function SetInterfaceSafetyOptions(const IID: TIID; dwOptionSetMask,
  164.       dwEnabledOptions: DWORD): HResult; virtual; stdcall;
  165.     { IOleObject }
  166.     function SetClientSite(const clientSite: IOleClientSite): HResult;
  167.       stdcall;
  168.     function GetClientSite(out clientSite: IOleClientSite): HResult;
  169.       stdcall;
  170.     function SetHostNames(szContainerApp: POleStr;
  171.       szContainerObj: POleStr): HResult; stdcall;
  172.     function Close(dwSaveOption: Longint): HResult; stdcall;
  173.     function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;
  174.       stdcall;
  175.     function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
  176.       out mk: IMoniker): HResult; stdcall;
  177.     function InitFromData(const dataObject: IDataObject; fCreation: BOOL;
  178.       dwReserved: Longint): HResult; stdcall;
  179.     function GetClipboardData(dwReserved: Longint;
  180.       out dataObject: IDataObject): HResult; stdcall;
  181.     function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;
  182.       lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
  183.       stdcall;
  184.     function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;
  185.     function Update: HResult; stdcall;
  186.     function IsUpToDate: HResult; stdcall;
  187.     function GetUserClassID(out clsid: TCLSID): HResult; stdcall;
  188.     function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
  189.       stdcall;
  190.     function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
  191.       stdcall;
  192.     function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
  193.       stdcall;
  194.     function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
  195.       stdcall;
  196.     function Unadvise(dwConnection: Longint): HResult; stdcall;
  197.     function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
  198.     function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
  199.       stdcall;
  200.     function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;
  201.     { IOleControl }
  202.     function GetControlInfo(var ci: TControlInfo): HResult; stdcall;
  203.     function OnMnemonic(msg: PMsg): HResult; stdcall;
  204.     function OnAmbientPropertyChange(dispid: TDispID): HResult; stdcall;
  205.     function FreezeEvents(bFreeze: BOOL): HResult; stdcall;
  206.     { IOleWindow }
  207.     function GetWindow(out wnd: HWnd): HResult; stdcall;
  208.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
  209.     { IOleInPlaceObject }
  210.     function InPlaceDeactivate: HResult; stdcall;
  211.     function UIDeactivate: HResult; stdcall;
  212.     function SetObjectRects(const rcPosRect: TRect;
  213.       const rcClipRect: TRect): HResult; stdcall;
  214.     function ReactivateAndUndo: HResult; stdcall;
  215.     { IOleInPlaceActiveObject }
  216.     function TranslateAccelerator(var msg: TMsg): HResult; stdcall;
  217.     function OnFrameWindowActivate(fActivate: BOOL): HResult; stdcall;
  218.     function OnDocWindowActivate(fActivate: BOOL): HResult; stdcall;
  219.     function ResizeBorder(const rcBorder: TRect; const uiWindow: IOleInPlaceUIWindow;
  220.       fFrameWindow: BOOL): HResult; stdcall;
  221.     function EnableModeless(fEnable: BOOL): HResult; stdcall;
  222.     { IViewObject }
  223.     function Draw(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
  224.       ptd: PDVTargetDevice; hicTargetDev: HDC; hdcDraw: HDC;
  225.       prcBounds: PRect; prcWBounds: PRect; fnContinue: TContinueFunc;
  226.       dwContinue: Longint): HResult; stdcall;
  227.     function GetColorSet(dwDrawAspect: Longint; lindex: Longint;
  228.       pvAspect: Pointer; ptd: PDVTargetDevice; hicTargetDev: HDC;
  229.       out colorSet: PLogPalette): HResult; stdcall;
  230.     function Freeze(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
  231.       out dwFreeze: Longint): HResult; stdcall;
  232.     function Unfreeze(dwFreeze: Longint): HResult; stdcall;
  233.     function SetAdvise(aspects: Longint; advf: Longint;
  234.       const advSink: IAdviseSink): HResult; stdcall;
  235.     function GetAdvise(pAspects: PLongint; pAdvf: PLONGINT;
  236.       out advSink: IAdviseSink): HResult; stdcall;
  237.     { IViewObject2 }
  238.     function ViewObjectGetExtent(dwDrawAspect: Longint; lindex: Longint;
  239.       ptd: PDVTargetDevice; out size: TPoint): HResult; stdcall;
  240.     { IPerPropertyBrowsing }
  241.     function GetDisplayString(dispid: TDispID; out bstr: WideString): HResult; stdcall;
  242.     function MapPropertyToPage(dispid: TDispID; out clsid: TCLSID): HResult; stdcall;
  243.     function GetPredefinedStrings(dispid: TDispID; out caStringsOut: TCAPOleStr;
  244.       out caCookiesOut: TCALongint): HResult; stdcall;
  245.     function GetPredefinedValue(dispid: TDispID; dwCookie: Longint;
  246.       out varOut: OleVariant): HResult; stdcall;
  247.     { ISpecifyPropertyPages }
  248.     function GetPages(out pages: TCAGUID): HResult; stdcall;
  249.     { ISimpleFrameSite }
  250.     function PreMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
  251.       out res: Integer; out Cookie: Longint): HResult; stdcall;
  252.     function PostMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
  253.       out res: Integer; Cookie: Longint): HResult; stdcall;
  254.     { Standard properties }
  255.     function Get_BackColor: Integer; safecall;
  256.     function Get_Caption: WideString; safecall;
  257.     function Get_Enabled: WordBool; safecall;
  258.     function Get_Font: Font; safecall;
  259.     function Get_ForeColor: Integer; safecall;
  260.     function Get_HWnd: Integer; safecall;
  261.     function Get_TabStop: WordBool; safecall;
  262.     function Get_Text: WideString; safecall;
  263.     procedure Set_BackColor(Value: Integer); safecall;
  264.     procedure Set_Caption(const Value: WideString); safecall;
  265.     procedure Set_Enabled(Value: WordBool); safecall;
  266.     procedure Set_Font(const Value: Font); safecall;
  267.     procedure Set_ForeColor(Value: Integer); safecall;
  268.     procedure Set_TabStop(Value: WordBool); safecall;
  269.     procedure Set_Text(const Value: WideString); safecall;
  270.     { Standard event handlers }
  271.     procedure StdClickEvent(Sender: TObject);
  272.     procedure StdDblClickEvent(Sender: TObject);
  273.     procedure StdKeyDownEvent(Sender: TObject; var Key: Word;
  274.       Shift: TShiftState);
  275.     procedure StdKeyPressEvent(Sender: TObject; var Key: Char);
  276.     procedure StdKeyUpEvent(Sender: TObject; var Key: Word;
  277.       Shift: TShiftState);
  278.     procedure StdMouseDownEvent(Sender: TObject; Button: TMouseButton;
  279.       Shift: TShiftState; X, Y: Integer);
  280.     procedure StdMouseMoveEvent(Sender: TObject; Shift: TShiftState;
  281.       X, Y: Integer);
  282.     procedure StdMouseUpEvent(Sender: TObject; Button: TMouseButton;
  283.       Shift: TShiftState; X, Y: Integer);
  284.     { Helper methods }
  285.     function InPlaceActivate(ActivateUI: Boolean): HResult;
  286.     procedure ShowPropertyDialog;
  287.     { Overrideable methods }
  288.     procedure DefinePropertyPages(
  289.       DefinePropertyPage: TDefinePropertyPage); virtual;
  290.     procedure EventSinkChanged(const EventSink: IUnknown); virtual;
  291.     function GetPropertyString(DispID: Integer;
  292.       var S: string): Boolean; virtual;
  293.     function GetPropertyStrings(DispID: Integer;
  294.       Strings: TStrings): Boolean; virtual;
  295.     procedure GetPropertyValue(DispID, Cookie: Integer;
  296.       var Value: OleVariant); virtual;
  297.     procedure GetPropFromBag(const PropName: WideString; DispatchID: Integer;
  298.       PropBag: IPropertyBag; ErrorLog: IErrorLog); virtual;
  299.     procedure InitializeControl; virtual;
  300.     procedure LoadFromStream(const Stream: IStream); virtual;
  301.     procedure PerformVerb(Verb: Integer); virtual;
  302.     procedure PutPropInBag(const PropName: WideString; DispatchID: Integer;
  303.       PropBag: IPropertyBag); virtual;
  304.     procedure SaveToStream(const Stream: IStream); virtual;
  305.     procedure WndProc(var Message: TMessage); virtual;
  306.   public
  307.     destructor Destroy; override;
  308.     procedure Initialize; override;
  309.     function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
  310.     function PropRequestEdit(const PropertyName: WideString): Boolean;
  311.     procedure PropChanged(const PropertyName: WideString);
  312.     property Control: TWinControl;
  313.   end;
  314.  
  315.   TActiveXControlClass = class of TActiveXControl;
  316.  
  317.   TActiveXControlFactory = class(TAutoObjectFactory)
  318.   protected
  319.     function GetLicenseFileName: string; virtual;
  320.     function HasMachineLicense: Boolean; override;
  321.   public
  322.     constructor Create(ComServer: TComServerObject;
  323.       ActiveXControlClass: TActiveXControlClass;
  324.       WinControlClass: TWinControlClass; const ClassID: TGUID;
  325.       ToolboxBitmapID: Integer; const LicStr: string; MiscStatus: Integer);
  326.     destructor Destroy; override;
  327.     procedure AddVerb(Verb: Integer; const VerbName: string);
  328.     procedure UpdateRegistry(Register: Boolean); override;
  329.     property EventIID: TGUID;
  330.     property EventTypeInfo: ITypeInfo;
  331.     property MiscStatus: Integer;
  332.     property ToolboxBitmapID: Integer;
  333.     property WinControlClass: TWinControlClass;
  334.   end;
  335.  
  336.   { ActiveFormControl }
  337.  
  338.   {$EXTERNALSYM TActiveFormControl}
  339.   TActiveFormControl = class(TActiveXControl, IVCLComObject)
  340.   protected
  341.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  342.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  343.   public
  344.     procedure FreeOnRelease;
  345.     procedure InitializeControl; override;
  346.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  347.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
  348.       override;
  349.     function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
  350.   end;
  351.  
  352.   { ActiveForm }
  353.  
  354.   {$EXTERNALSYM TActiveForm}
  355.   TActiveForm = class(TCustomActiveForm)
  356.   protected
  357.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); virtual;
  358.     procedure EventSinkChanged(const EventSink: IUnknown); virtual;
  359.     procedure Initialize; virtual;
  360.   end;
  361.  
  362.   {$EXTERNALSYM TActiveFormClass}
  363.   TActiveFormClass = class of TActiveForm;
  364.  
  365.   { ActiveFormFactory }
  366.  
  367.   {$EXTERNALSYM TActiveFormFactory}
  368.   TActiveFormFactory = class(TActiveXControlFactory)
  369.   public
  370.     function GetIntfEntry(Guid: TGUID): PInterfaceEntry; override;
  371.   end;
  372.  
  373.   { Property Page support }
  374.  
  375.   TPropertyPageImpl = class;
  376.  
  377.   TPropertyPage = class(TCustomForm)
  378.   public
  379.     constructor Create(AOwner: TComponent); override;
  380.     destructor Destroy; override;
  381.     procedure Modified;
  382.     procedure UpdateObject; virtual;
  383.     procedure UpdatePropertyPage; virtual;
  384.     property OleObject: OleVariant;
  385.     property OleObjects: TInterfaceList;
  386.     procedure EnumCtlProps(PropType: TGUID; PropNames: TStrings);
  387.   published
  388.     property ActiveControl;
  389.     property AutoScroll;
  390.     property Caption;
  391.     property ClientHeight;
  392.     property ClientWidth;
  393.     property Ctl3D;
  394.     property Color;
  395.     property Enabled;
  396.     property Font;
  397.     property Height;
  398.     property HorzScrollBar;
  399.     property KeyPreview;
  400.     property PixelsPerInch;
  401.     property ParentFont;
  402.     property PopupMenu;
  403.     property PrintScale;
  404.     property Scaled;
  405.     property ShowHint;
  406.     property VertScrollBar;
  407.     property Visible;
  408.     property Width;
  409.     property OnActivate;
  410.     property OnClick;
  411.     property OnClose;
  412.     property OnCreate;
  413.     property OnDblClick;
  414.     property OnDestroy;
  415.     property OnDeactivate;
  416.     property OnDragDrop;
  417.     property OnDragOver;
  418.     property OnHide;
  419.     property OnKeyDown;
  420.     property OnKeyPress;
  421.     property OnKeyUp;
  422.     property OnMouseDown;
  423.     property OnMouseMove;
  424.     property OnMouseUp;
  425.     property OnPaint;
  426.     property OnResize;
  427.     property OnShow;
  428.   end;
  429.  
  430.   TPropertyPageClass = class of TPropertyPage;
  431.  
  432.   TPropertyPageImpl = class(TAggregatedObject, IUnknown, IPropertyPage, IPropertyPage2)
  433.   protected
  434.     { IUnknown }
  435.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  436.     { IPropertyPage }
  437.     function SetPageSite(const pageSite: IPropertyPageSite): HResult; stdcall;
  438.     function Activate(hwndParent: HWnd; const rc: TRect; bModal: BOOL): HResult;
  439.       stdcall;
  440.     function Deactivate: HResult; stdcall;
  441.     function GetPageInfo(out pageInfo: TPropPageInfo): HResult; stdcall;
  442.     function SetObjects(cObjects: Longint; pUnkList: PUnknownList): HResult; stdcall;
  443.     function Show(nCmdShow: Integer): HResult; stdcall;
  444.     function Move(const rect: TRect): HResult; stdcall;
  445.     function IsPageDirty: HResult; stdcall;
  446.     function Apply: HResult; stdcall;
  447.     function Help(pszHelpDir: POleStr): HResult; stdcall;
  448.     function TranslateAccelerator(msg: PMsg): HResult; stdcall;
  449.     { IPropertyPage2 }
  450.     function EditProperty(dispid: TDispID): HResult; stdcall;
  451.   public
  452.     procedure InitPropertyPage; virtual;
  453.     property PropertyPage: TPropertyPage;
  454.   end;
  455.  
  456.   {$EXTERNALSYM TActiveXPropertyPage}
  457.   TActiveXPropertyPage = class(TComObject)
  458.   public
  459.     destructor Destroy; override;
  460.     function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  461.     procedure Initialize; override;
  462.     property PropertyPageImpl: TPropertyPageImpl;
  463.   end;
  464.  
  465.   {$EXTERNALSYM TActiveXPropertyPageFactory}
  466.   TActiveXPropertyPageFactory = class(TComObjectFactory)
  467.   protected
  468.     function CreateComObject(const Controller: IUnknown): TComObject; override;
  469.   public
  470.     constructor Create(ComServer: TComServerObject;
  471.       PropertyPageClass: TPropertyPageClass; const ClassID: TGUID);
  472.   end;
  473.  
  474.   { Type adapter support }
  475.  
  476.   TCustomAdapter = class(TInterfacedObject)
  477.   protected
  478.     Updating: Boolean;
  479.     procedure Changed; virtual;
  480.     procedure ConnectOleObject(OleObject: IUnknown);
  481.     procedure ReleaseOleObject;
  482.     procedure Update; virtual; abstract;
  483.   public
  484.     constructor Create;
  485.     destructor Destroy; override;
  486.   end;
  487.  
  488.   TAdapterNotifier = class(TInterfacedObject,
  489.     IPropertyNotifySink)
  490.   protected
  491.     { IPropertyNotifySink }
  492.     function OnChanged(dispid: TDispID): HResult; stdcall;
  493.     function OnRequestEdit(dispid: TDispID): HResult; stdcall;
  494.   public
  495.     constructor Create(Adapter: TCustomAdapter);
  496.   end;
  497.  
  498.   IFontAccess = interface
  499.     ['{CBA55CA0-0E57-11D0-BD2F-0020AF0E5B81}']
  500.     procedure GetOleFont(var OleFont: IFontDisp);
  501.     procedure SetOleFont(const OleFont: IFontDisp);
  502.   end;
  503.  
  504.   TFontAdapter = class(TCustomAdapter,
  505.     IChangeNotifier,
  506.     IFontAccess)
  507.   protected
  508.     { IFontAccess }
  509.     procedure GetOleFont(var OleFont: IFontDisp);
  510.     procedure SetOleFont(const OleFont: IFontDisp);
  511.     procedure Changed; override;
  512.     procedure Update; override;
  513.   public
  514.     constructor Create(Font: TFont);
  515.   end;
  516.  
  517.   IPictureAccess = interface
  518.     ['{795D4D31-43D7-11D0-9E92-0020AF3D82DA}']
  519.     procedure GetOlePicture(var OlePicture: IPictureDisp);
  520.     procedure SetOlePicture(const OlePicture: IPictureDisp);
  521.   end;
  522.  
  523.   TPictureAdapter = class(TCustomAdapter,
  524.     IChangeNotifier,
  525.     IPictureAccess)
  526.   protected
  527.     { IPictureAccess }
  528.     procedure GetOlePicture(var OlePicture: IPictureDisp);
  529.     procedure SetOlePicture(const OlePicture: IPictureDisp);
  530.     procedure Update; override;
  531.   public
  532.     constructor Create(Picture: TPicture);
  533.   end;
  534.  
  535.   TOleGraphic = class(TGraphic)
  536.   protected
  537.     procedure Changed(Sender: TObject); override;
  538.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  539.     function GetEmpty: Boolean; override;
  540.     function GetHeight: Integer; override;
  541.     function GetPalette: HPALETTE; override;
  542.     function GetTransparent: Boolean; override;
  543.     function GetWidth: Integer; override;
  544.     procedure SetHeight(Value: Integer); override;
  545.     procedure SetPalette(Value: HPALETTE); override;
  546.     procedure SetWidth(Value: Integer); override;
  547.   public
  548.     procedure Assign(Source: TPersistent); override;
  549.     procedure LoadFromFile(const Filename: string); override;
  550.     procedure LoadFromStream(Stream: TStream); override;
  551.     procedure SaveToStream(Stream: TStream); override;
  552.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  553.       APalette: HPALETTE); override;
  554.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  555.       var APalette: HPALETTE); override;
  556.     property MMHeight: Integer;      // in .01 mm units
  557.     property MMWidth: Integer;
  558.     property Picture: IPicture;
  559.   end;
  560.  
  561.   TStringsAdapter = class(TAutoIntfObject, IStrings, IStringsAdapter)
  562.   protected
  563.     { IStringsAdapter }
  564.     procedure ReferenceStrings(S: TStrings);
  565.     procedure ReleaseStrings;
  566.     { IStrings }
  567.     function Get_ControlDefault(Index: Integer): OleVariant; safecall;
  568.     procedure Set_ControlDefault(Index: Integer; Value: OleVariant); safecall;
  569.     function Count: Integer; safecall;
  570.     function Get_Item(Index: Integer): OleVariant; safecall;
  571.     procedure Set_Item(Index: Integer; Value: OleVariant); safecall;
  572.     procedure Remove(Index: Integer); safecall;
  573.     procedure Clear; safecall;
  574.     function Add(Item: OleVariant): Integer; safecall;
  575.     function _NewEnum: IUnknown; safecall;
  576.   public
  577.     constructor Create(Strings: TStrings);
  578.   end;
  579.  
  580.   TReflectorWindow = class(TWinControl)
  581.   public
  582.     // jmt.  Change to integer to work around managled name mismatch
  583.     // when called from BCB.
  584.     constructor Create(ParentWindow: Integer; Control: TControl);
  585.   end;
  586.  
  587. function GetDispatchPropValue(Disp: IDispatch; DispID: Integer): OleVariant;
  588. procedure SetDispatchPropValue(Disp: IDispatch; DispID: Integer;
  589.   const Value: OleVariant);
  590. procedure EnumDispatchProperties(Dispatch: IDispatch; PropType: TGUID;
  591.   VTCode: Integer; PropList: TStrings);
  592.  
  593. procedure GetOleFont(Font: TFont; var OleFont: IFontDisp);
  594. procedure SetOleFont(Font: TFont; OleFont: IFontDisp);
  595. procedure GetOlePicture(Picture: TPicture; var OlePicture: IPictureDisp);
  596. procedure SetOlePicture(Picture: TPicture; OlePicture: IPictureDisp);
  597. procedure GetOleStrings(Strings: TStrings; var OleStrings: IStrings);
  598. procedure SetOleStrings(Strings: TStrings; OleStrings: IStrings);
  599.  
  600. function ParkingWindow: HWND;
  601.  
  602. implementation
  603.